home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / popupelems.mod (.txt) < prev    next >
Oberon Text  |  1996-05-07  |  23KB  |  514 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 7 May 96
  5. Syntax10b.Scn.Fnt
  6. Syntax10i.Scn.Fnt
  7. FoldElems
  8. MODULE PopupElems;    (** MF 27.1.92 /MH/CM/MAH/HM, old Style by Ralf Degner 
  9. IMPORT
  10.     Modules, Oberon, Input, Display, Viewers, Files, Fonts, Printer,
  11.     Texts, MenuViewers, TextFrames, TextPrinter, Bitmaps;
  12. CONST
  13.     oldStyle = TRUE; (* use old ETH or new Linz style *)     (*<<RD*)
  14.     ehm = 4; evm = 3;    (*element: horizontal margin, vertical margin*)
  15.     mhm = 5; mvm = 2;    (*menu: horizontal margin, vertical margin*)
  16.     CR = 0DX;
  17.     DUnit = TextFrames.Unit; PUnit = TextPrinter.Unit;
  18.     MR = 0; MM = 1; ML = 2; cancel = {ML, MM, MR};
  19.     white = 0; grey1 = 12; grey2 = 13; grey3 = 14; black = 15;
  20.     Elem* = POINTER TO ElemDesc;
  21.     ElemDesc* = RECORD(Texts.ElemDesc)
  22.         name*: ARRAY 32 OF CHAR;
  23.         menu*: Texts.Text;
  24.         small*: BOOLEAN;    (** TRUE if elem displays itself small *)
  25.         beg, end: LONGINT;    (*displayed text stretch in menu*)
  26.         n, def: INTEGER;    (* number of items, default item*)
  27.         wid, lsp, dsc: INTEGER    (*width, line space, descender of item lines*)
  28.     END;
  29.     EditFrame = POINTER TO EditFrameDesc;
  30.     EditFrameDesc = RECORD (TextFrames.FrameDesc)
  31.         elem: Elem
  32.     END;
  33.     ExecMsg* = RECORD (Texts.ElemMsg)
  34.         frame*: Display.Frame;
  35.         pos*: LONGINT;
  36.         keys*: SET
  37.     END;
  38.     elemPressed: BOOLEAN;  (*TRUE if popup elem should be drawn in pressed mode*)
  39.     fullPlot: BOOLEAN; (*FALSE if Popup allready drawn *)     (*<<RD*)
  40.     buf: Texts.Buffer;    (* copy buffer *)
  41.     Wr: Texts.Writer;
  42. (* auxiliary *)
  43. PROCEDURE Min (x, y: INTEGER): INTEGER;    
  44. BEGIN IF x<y THEN RETURN x ELSE RETURN y END
  45. END Min;
  46. PROCEDURE Max (x, y: INTEGER): INTEGER;    
  47. BEGIN IF x>y THEN RETURN x ELSE RETURN y END
  48. END Max;
  49. PROCEDURE CopyText (T: Texts.Text): Texts.Text;    
  50.     VAR t: Texts.Text; buf: Texts.Buffer; (*Save destroys the global buf*)
  51. BEGIN
  52.     NEW(buf); Texts.OpenBuf(buf); Texts.Save(T, 0, T.len, buf);
  53.     t := TextFrames.Text(""); Texts.Append(t, buf); RETURN t
  54. END CopyText;
  55. PROCEDURE SetDefaultMenu (E: Elem); 
  56. BEGIN
  57.     Texts.WriteString(Wr, "right interclick to edit menu");
  58.     Texts.WriteLn(Wr); Texts.WriteLn(Wr); Texts.Append(E.menu, Wr.buf)
  59. END SetDefaultMenu;
  60. PROCEDURE Set (VAR r: Texts.Reader; t: Texts.Text; pos: LONGINT; line: INTEGER);    
  61.     VAR i: INTEGER; ch: CHAR;
  62. BEGIN
  63.     Texts.OpenReader(r, t, pos);
  64.     FOR i := 0 TO line-1 DO
  65.         REPEAT Texts.Read(r, ch) UNTIL ch = CR
  66. END Set;
  67. PROCEDURE Restore (e: Elem);    
  68.     VAR t: Texts.Text; pos: LONGINT;
  69. BEGIN
  70.     t := Texts.ElemBase(e); pos := Texts.ElemPos(e);
  71.     t.notify(t, Texts.replace, pos, pos+1)
  72. END Restore;
  73. (* metrics *)
  74. PROCEDURE MeasureElem (E: Elem; fnt: Fonts.Font);    
  75.     VAR i, wid, dx, x, y, w, h: INTEGER; p: LONGINT;
  76. BEGIN
  77.     IF E.small THEN E.H := LONG(TextFrames.menuH-1)*DUnit
  78.     ELSE E.H := LONG(fnt.maxY-fnt.minY+2*evm)*DUnit
  79.     END;
  80.     IF oldStyle & E.small THEN wid:=0 ELSE wid := 2*ehm END; (* no offset for small oldStyle *)    (*<<RD*)
  81.     i := 0;
  82.     WHILE E.name[i] # 0X DO Display.GetChar(fnt.raster, E.name[i], dx, x, y, w, h, p); INC(wid, dx); INC(i) END;
  83.     E.W := LONG(wid)*DUnit
  84. END MeasureElem;
  85. PROCEDURE MeasureMenu* (E: Elem);    
  86.     (*compute E.n, E.def, E.wid, E.lsp, E.dsc*)
  87.     VAR r: Texts.Reader; ch, oldCh: CHAR; wid, dx, x, y, w, h: INTEGER; p: LONGINT;
  88. BEGIN
  89.     IF E.menu.len = 0 THEN SetDefaultMenu(E) END;
  90.     E.wid := 0; E.n := 1; E.lsp := 0; wid := 0; oldCh := 0X; E.def := -1;
  91.     Texts.OpenReader(r, E.menu, 0); Texts.Read(r, ch);
  92.     WHILE ~r.eot DO
  93.         IF ch = CR THEN E.wid := Max(E.wid, wid); wid := 0; INC(E.n)
  94.         ELSIF r.elem # NIL THEN
  95.             E.lsp := Max(E.lsp, SHORT(r.elem.H DIV TextFrames.Unit));
  96.             INC(wid, SHORT(r.elem.W DIV TextFrames.Unit))
  97.         ELSE
  98.             E.lsp := Max(E.lsp, r.fnt.height); E.dsc := Min(E.dsc, r.fnt.minY);
  99.             Display.GetChar(r.fnt.raster, ch, dx, x, y, w, h, p); INC(wid, dx)
  100.         END;
  101.         oldCh := ch; Texts.Read(r, ch)
  102.     END;
  103.     IF oldCh = CR THEN DEC(E.n) END;
  104.     E.wid := Max(E.wid, wid); INC(E.lsp)
  105. END MeasureMenu;
  106. (* interactive editing of popup menus *)
  107. PROCEDURE HandleEdit (F: Display.Frame; VAR M: Display.FrameMsg);    
  108.     VAR F1: EditFrame;
  109. BEGIN
  110.     TextFrames.Handle(F, M);
  111.     WITH F: EditFrame DO
  112.         IF M IS Oberon.CopyMsg THEN
  113.             NEW(F1);
  114.             TextFrames.Open(F1, F.text, F.org);
  115.             F1.handle := F.handle; F1.elem := F.elem; M(Oberon.CopyMsg).F := F1
  116.         END
  117. END HandleEdit;
  118. PROCEDURE OpenEditor (E: Elem);    
  119.     VAR V: Viewers.Viewer; F: EditFrame; x, y, i: INTEGER; name: ARRAY 34 OF CHAR;
  120. BEGIN
  121.     name[0] := 22X; i := 0;    (* 22X = " *)
  122.     WHILE E.name[i] # 0X DO name[i+1] := E.name[i]; INC(i) END;
  123.     name[i+1] := 22X; name[i+2] := 0X;
  124.     Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  125.     NEW(F); F.elem := E; TextFrames.Open(F, CopyText(E.menu), 0); F.handle := HandleEdit;
  126.     V := MenuViewers.New(TextFrames.NewMenu(name,
  127.             "System.Close  System.Copy  System.Grow  PopupElems.Toggle  PopupElems.Update "),
  128.             F, TextFrames.menuH, x, y)
  129. END OpenEditor;
  130. (* file input/output *)
  131. PROCEDURE Load (VAR R: Files.Rider; E: Elem);    
  132.     CONST VersionTag = 01X; menuElem = 0;
  133.     VAR ch: CHAR; val: LONGINT; options: SET;
  134. BEGIN
  135.     Files.Read (R, ch);
  136.     IF ch = VersionTag THEN
  137.         Files.ReadString (R, E.name);
  138.         Files.ReadNum (R, val);
  139.         Files.ReadSet (R, options);
  140.         IF menuElem IN options THEN E.small:=TRUE ELSE E.small:=FALSE END
  141.     ELSE
  142.         Files.Set (R, Files.Base (R), Files.Pos (R)-1);
  143.         Files.ReadString(R, E.name);
  144.         Files.ReadBool(R, E.small)
  145.     END;
  146.     E.menu := TextFrames.Text(""); Texts.Load(R, E.menu)
  147. END Load
  148. PROCEDURE Store (VAR R: Files.Rider; E: Elem);    
  149. BEGIN
  150.     Files.WriteString(R, E.name);
  151.     Files.WriteBool(R,E.small);
  152.     Texts.Store(R, E.menu)
  153. END Store;
  154. (* graphics *)
  155. PROCEDURE PrintElem (E: Elem; X, Y: INTEGER; fnt: Fonts.Font);    
  156.     VAR W, H: INTEGER;
  157. BEGIN W:=SHORT((E.W-1) DIV PUnit); H:=SHORT(E.H DIV PUnit);
  158.     IF E.small THEN Printer.String(X, Y, E.name, fnt.name); Printer.ReplPattern(X, Y-2, W, 1, 2)
  159.     ELSE
  160.         INC (W, 2 * ehm * DUnit DIV PUnit);
  161.         Printer.ReplConst(X, Y, W, 2);
  162.         Printer.ReplConst(X, Y+H-2, W, 2);
  163.         Printer.ReplConst(X, Y+2, 2, H-4);
  164.         Printer.ReplConst(X+W-2, Y+2, 2, H-4);
  165.         Printer.String(X + ehm * DUnit DIV PUnit, Y + SHORT(LONG(evm-fnt.minY)*DUnit DIV PUnit),
  166.             E.name, fnt.name)
  167. END PrintElem;
  168. PROCEDURE DrawBigElem (pressed: BOOLEAN; X, Y, W, H: INTEGER);    
  169. BEGIN
  170.     IF oldStyle THEN        (*<<RD*)
  171.         IF fullPlot THEN
  172.             Display.ReplConst(Display.white, X+2, Y, W-2, H-2, Display.replace);
  173.             Display.ReplConst(Display.white, X, Y+1, W-1, H-1, Display.replace);
  174.             Display.ReplConst(Display.black, X+1, Y+2, W-3, H-3, Display.replace)
  175.         ELSE
  176.             IF pressed THEN
  177.                 Display.ReplConst(Display.black, X+2, Y, W-2, 1, Display.replace);
  178.                 Display.ReplConst(Display.black, X+W-1, Y, 1, H-2, Display.replace)
  179.             ELSE
  180.                 Display.ReplConst(Display.white, X+2, Y, W-2, 1, Display.replace);
  181.                 Display.ReplConst(Display.white, X+W-1, Y, 1, H-2, Display.replace)
  182.             END
  183.         END
  184.     ELSE
  185.         IF pressed THEN
  186.             Display.ReplConst(grey1, X, Y, W, H, Display.replace);
  187.             Display.ReplConst(grey3, X, Y+2, W-2, H-2, Display.replace);
  188.             Display.ReplConst(grey2, X+2, Y+2, W-4, H-4, Display.replace);
  189.             Display.Dot(grey3, X, Y+1, Display.replace);
  190.             Display.Dot(grey3, X+W-2, Y+H-1, Display.replace)
  191.         ELSE
  192.             Display.ReplConst(grey3, X, Y, W, H, Display.replace);
  193.             Display.ReplConst(grey1, X, Y+2, W-2, H-2, Display.replace);
  194.             Display.ReplConst(grey2, X+2, Y+2, W-4, H-4, Display.replace);
  195.             Display.Dot(grey1, X, Y+1, Display.replace);
  196.             Display.Dot(grey1, X+W-2, Y+H-1, Display.replace)
  197.         END
  198. END DrawBigElem;
  199. PROCEDURE DrawSmallElem (pressed: BOOLEAN; X, Y, W, H: INTEGER);    
  200. BEGIN
  201.     IF oldStyle THEN     (*<<RD*)
  202.         Display.ReplPattern(Display.white, Display.grey1, X, Y+1, W, 1, Display.invert)
  203.     ELSE
  204.         IF pressed THEN
  205.             Display.ReplConst(white, X, Y, W, H, Display.replace);
  206.             Display.ReplConst(grey3, X, Y+1, W-1, H-1, Display.replace);
  207.             Display.ReplConst(grey2, X+1, Y+1, W-2, H-2, Display.replace)
  208.         ELSE
  209.             Display.ReplConst(black, X, Y, W, H, Display.replace);
  210.             Display.ReplConst(grey3, X, Y+1, W-1, H-1, Display.replace);
  211.             Display.ReplConst(grey2, X, Y+2, W-2, H-2, Display.replace);
  212.             Display.ReplConst(white, X, Y+1, 1, H-1, Display.replace);
  213.             Display.ReplConst(white, X, Y+H-1, W-1, 1, Display.replace)
  214.         END
  215. END DrawSmallElem;
  216. PROCEDURE DrawElem (E: Elem; col: SHORTINT; X, Y: INTEGER; fnt: Fonts.Font);    
  217.     VAR W, H: INTEGER; i, x, y, w, h, dx: INTEGER; pat: Display.Pattern;
  218. BEGIN
  219.     W := SHORT(E.W DIV DUnit); H := SHORT(E.H DIV DUnit);
  220.     Oberon.RemoveMarks(X, Y, W, H);        (*<<RD*)
  221.     IF E.small THEN DrawSmallElem(elemPressed, X, Y, W, H); INC(Y, 3)
  222.     ELSE DrawBigElem(elemPressed, X, Y, W, H); INC(Y, evm-fnt.minY)
  223.     END;
  224.     IF ~(oldStyle & E.small) THEN INC(X, ehm) END; (* no offset for small oldStyle *)    (*<<RD*)
  225.     IF fullPlot THEN
  226.         i := 0;
  227.         WHILE E.name[i] # 0X DO
  228.             Display.GetChar(fnt.raster, E.name[i], dx, x, y, w, h, pat);
  229.             IF oldStyle THEN     (*<<RD*)
  230.                 Display.CopyPattern(col, pat, X+x, Y+y, Display.invert)
  231.             ELSE
  232.                 Display.CopyPattern(col, pat, X+x, Y+y, Display.paint)
  233.             END;
  234.             INC(X, dx); INC(i)
  235.         END
  236. END DrawElem;
  237. PROCEDURE DrawLine (VAR r: Texts.Reader; f: Display.Frame; X, Y: INTEGER);    
  238.     VAR e: Texts.Elem; ch: CHAR; dx, x, y, w, h: INTEGER; pat: Display.Pattern;
  239.         m: TextFrames.DisplayMsg;
  240. BEGIN
  241.     LOOP Texts.Read(r, ch);
  242.         IF r.eot OR (ch = CR) THEN EXIT
  243.         ELSIF r.elem # NIL THEN
  244.             e := r.elem; y := r.fnt.minY;
  245.             m.prepare := FALSE; m.fnt := r.fnt; m.col := r.col; m.pos := Texts.Pos(r) - 1;
  246.             m.frame := f; m.X0 := X; m.Y0 := Y+y; m.elemFrame := NIL;
  247.             IF ~oldStyle THEN e.handle(e, m) END;        (*<<RD*)
  248.             INC(X, SHORT(e.W DIV TextFrames.Unit))
  249.         ELSE
  250.             Display.GetChar (r.fnt.raster, ch, dx, x, y, w, h, pat);
  251.             IF oldStyle THEN     (*<<RD*)
  252.                 Display.CopyPattern(r.col, pat, X+x, Y+y, Display.invert)
  253.             ELSE
  254.                 Display.CopyPattern(r.col, pat, X+x, Y+y, Display.paint)
  255.             END;
  256.             INC(X, dx)
  257.         END
  258. END DrawLine;
  259. PROCEDURE DrawMenu(E: Elem; F: Display.Frame; X, Y, W, H: INTEGER);    
  260.     VAR R: Texts.Reader; X0, bot: INTEGER;
  261. BEGIN
  262.     E.beg := 0;
  263.     IF E.n > 1 THEN
  264.         IF oldStyle THEN
  265.             Display.ReplConst(Display.white, X, Y, W, H, Display.replace);
  266.             Display.ReplConst(Display.black, X+1, Y+1, W-2, H-2, Display.replace)
  267.         ELSE
  268.             Display.ReplConst(black, X, Y, W, H, Display.replace);
  269.             Display.ReplConst(grey2, X+1, Y+1, W-2, H-2, Display.replace)
  270.         END;
  271.         bot := Y + mvm - E.dsc;
  272.         X0 := X + mhm; X := X0; Y := Y + H - mvm - E.lsp - E.dsc;
  273.         Texts.OpenReader(R, E.menu, 0);
  274.         WHILE ~R.eot & (Y >= bot) DO
  275.             DrawLine(R, F, X, Y); Y := Y - E.lsp; X := X0
  276.         END;
  277.         E.end := Texts.Pos(R)
  278. END DrawMenu;
  279. (* actions *)
  280. PROCEDURE ExecCmd (E: Elem; F: Display.Frame; pos: LONGINT; keys: SET);    
  281.     VAR s: Texts.Scanner; par: Oberon.ParList; res, i, j: INTEGER; ch: CHAR; m: TextFrames.TrackMsg;
  282. BEGIN
  283.     Texts.OpenScanner(s, E.menu, pos); Texts.Scan(s);
  284.     IF (s.class = Texts.Name) & (s.line = 0) THEN
  285.         i := 0; WHILE (i < s.len) & (s.s[i] # ".") DO INC(i) END;
  286.         j := i + 1; WHILE (j < s.len) & (s.s[j] # ".") DO INC(j) END;
  287.         IF (j >= s.len) & (s.s[i] = ".") THEN
  288.             NEW(par); par.frame := F; par.vwr := Viewers.This(F.X, F.Y); par.text := E.menu; par.pos := Texts.Pos(s)-1;
  289.             Oberon.Call(s.s, par, ML IN keys, res);    (* left interclick -> unload module *)
  290.             IF res > 0 THEN
  291.                 Texts.WriteString(Wr, "Call error: "); Texts.WriteString(Wr, Modules.importing);
  292.                 IF (res = 1) OR (res = 5) THEN Texts.WriteString(Wr, " not found")
  293.                 ELSIF res = 2 THEN Texts.WriteString(Wr, " not an obj-file")
  294.                 ELSIF res = 3 THEN Texts.WriteString(Wr, " imports ");
  295.                     Texts.WriteString(Wr, Modules.imported); Texts.WriteString(Wr, " with bad key")
  296.                 ELSIF res = 4 THEN Texts.WriteString(Wr, " not enough memory")
  297.                 ELSIF res = 5 THEN Texts.WriteString(Wr, " module not found")
  298.                 ELSIF res = 6 THEN Texts.WriteString(Wr, " command not found")
  299.                 ELSE Texts.WriteString(Wr, " res = "); Texts.WriteInt(Wr, res, 0)
  300.                 END
  301.             ELSIF res < 0 THEN
  302.                 INC(i); WHILE i < s.len DO Texts.Write(Wr, s.s[i]); INC(i) END;
  303.                 Texts.WriteString(Wr, " not found")
  304.             END;
  305.             IF res # 0 THEN Texts.WriteLn(Wr); Texts.Append(Oberon.Log, Wr.buf) END
  306.         END
  307.     ELSIF (s.class = Texts.Char) & (s.c = Texts.ElemChar) & (s.line = 0) THEN
  308.         Texts.OpenReader(s, E.menu, pos); Texts.Read(s, ch);
  309.         m.frame := NIL; m.keys := {MM}; s.elem.handle(s.elem, m)
  310. END ExecCmd;
  311. PROCEDURE SelectMenu (E: Elem; F: Display.Frame; X, Y, W, H, ex, ey, ew, eh: INTEGER; VAR cmd: INTEGER; VAR keysum: SET);    
  312.     VAR mx, my, top, bot, left, right, newCmd: INTEGER; keys: SET; B: Bitmaps.Bitmap;
  313.     PROCEDURE TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET);    
  314.     BEGIN
  315.         Input.Mouse(keys, x, y); keysum := keysum+keys;
  316.         Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  317.     END TrackMouse;
  318.     PROCEDURE Flip (in: BOOLEAN; cmd: INTEGER);    
  319.         VAR R: Texts.Reader; x, y, w, h, X0, Y0: INTEGER;
  320.     BEGIN
  321.         IF (E.n > 1) & (cmd >= 0) THEN
  322.             X0 := X+mhm; Y0 := Y+H-(E.lsp*(cmd+1))-E.dsc-mvm;
  323.             x := left; y := Y0 + E.dsc - 1; w := right - left + 1; h := E.lsp + 2;
  324.             Oberon.RemoveMarks(x, y, w, h);        (*<<RD*)
  325.             IF oldStyle THEN
  326.                 Display.ReplConst(Display.black, x, y, w, h, Display.replace);
  327.                 IF in THEN
  328.                     Display.ReplConst(Display.white, x+1, y+1, w-2, h-2, Display.invert)
  329.                 END
  330.             ELSE
  331.                 IF in THEN
  332.                     Display.ReplConst(black, x, y, w, 1, Display.replace);
  333.                     Display.ReplConst(black, x+w-1, y, 1, h-1, Display.replace);
  334.                     Display.ReplConst(white, x, y+1, 1, h-1, Display.replace);
  335.                     Display.ReplConst(white, x, y+h-1, w, 1, Display.replace);
  336.                     Display.ReplConst(grey1, x+1, y+1, w-2, h-2, Display.replace)
  337.                 ELSE
  338.                     Display.ReplConst(grey2, x, y, w, h, Display.replace)
  339.                 END
  340.             END;
  341.             Set(R, E.menu, E.beg, cmd); DrawLine(R, F, X0, Y0)
  342.         END
  343.     END Flip;
  344.     PROCEDURE BwdLine (VAR pos: LONGINT);    
  345.         VAR r: Texts.Reader; ch: CHAR;
  346.     BEGIN
  347.         DEC(pos);
  348.         REPEAT
  349.             DEC(pos); Texts.OpenReader(r, E.menu, pos); Texts.Read(r, ch)
  350.         UNTIL (pos = 0) OR (ch = CR);
  351.         IF ch = CR THEN INC(pos) END
  352.     END BwdLine;
  353.     PROCEDURE FwdLine (VAR pos: LONGINT);    
  354.         VAR r: Texts.Reader; ch: CHAR;
  355.     BEGIN
  356.         Texts.OpenReader(r, E.menu, pos);
  357.         REPEAT Texts.Read(r, ch) UNTIL r.eot OR (ch = CR);
  358.         pos := Texts.Pos(r)
  359.     END FwdLine;
  360.     PROCEDURE ScrollUp;    
  361.     BEGIN
  362.         Flip(FALSE, cmd); cmd := H DIV E.lsp - 1;
  363.         Display.CopyBlock(left, bot, W-2, H-2*mvm-E.lsp, left, bot+E.lsp, Display.replace);
  364.         FwdLine(E.beg); FwdLine(E.end); Flip(FALSE, cmd)
  365.     END ScrollUp;
  366.     PROCEDURE ScrollDown;    
  367.     BEGIN
  368.         Flip(FALSE, cmd); cmd := 0;
  369.         Display.CopyBlock(left, bot+E.lsp, W-2, H-2*mvm-E.lsp, left, bot, Display.replace);
  370.         BwdLine(E.beg); BwdLine(E.end); Flip(FALSE, cmd)
  371.     END ScrollDown;
  372. BEGIN
  373.     left:=X+1; right:=X+W-2; bot:=Y+mvm; top:=Y+H-mvm;
  374.     Oberon.RemoveMarks(X, Y, W, H); Oberon.FadeCursor(Oberon.Mouse);
  375.     B := Bitmaps.New(W, H); Bitmaps.CopyBlock(Bitmaps.Disp, B, X, Y, W, H, 0, 0, 0);
  376.     DrawMenu(E, F, X, Y, W, H);
  377.     Flip(TRUE, cmd);
  378.     keysum := {}; newCmd := -1;
  379.     REPEAT
  380.         TrackMouse(mx, my, keys, keysum);
  381.         IF keysum = cancel THEN cmd := -1
  382.         ELSIF E.n = 1 THEN (*did not pop up*)
  383.             IF (mx >= ex) & (mx <= ex+ew) & (my >= ey) & (my <= ey+eh) THEN cmd := 0 ELSE cmd := -1 END
  384.         ELSIF (mx >= left) & (mx <= right) THEN
  385.             WHILE (my <= bot) & (E.end < E.menu.len) & (keys # {}) DO ScrollUp; TrackMouse(mx, my, keys, keysum) END;
  386.             WHILE (my >= top) & (E.beg > 0) & (keys # {}) DO
  387.                 Oberon.RemoveMarks(X, Y, W, H);        (*<<RD*)
  388.                 ScrollDown;
  389.                 TrackMouse(mx, my, keys, keysum)
  390.             END;
  391.             IF (my > bot) & (my <= top) THEN
  392.                 newCmd:=(top-my) DIV E.lsp;
  393.                 IF newCmd # cmd THEN
  394.                     Flip(FALSE, cmd); Flip(TRUE, newCmd); cmd:=newCmd
  395.                 END
  396.             ELSIF (mx < ex) OR (mx >= ex+ew) OR (my < ey) OR (my >= ey+eh) OR (newCmd >= 0) THEN
  397.                 Flip(FALSE, cmd); cmd := -1
  398.             END
  399.         ELSIF (mx < ex) OR (mx >= ex+ew) OR (my < ey) OR (my >= ey+eh) OR (newCmd >= 0) THEN
  400.             Flip(FALSE, cmd); cmd := -1
  401.         END
  402.     UNTIL keys = {};
  403. (*Out.F("keysum = #$", SYSTEM.VAL(LONGINT, keysum));
  404. IF keysum = cancel THEN HALT(99) END;*)
  405.     Oberon.FadeCursor(Oberon.Mouse);
  406.     Bitmaps.CopyBlock(B, Bitmaps.Disp, 0, 0, W, H, X, Y, 0)
  407. END SelectMenu;
  408. PROCEDURE Popup (E: Elem; col: SHORTINT; X, Y: INTEGER; fnt: Fonts.Font; F: Display.Frame);    
  409.     VAR W, H, menuX, menuY, menuW, menuH, cmd, i: INTEGER;
  410.         r: Texts.Reader; keys: SET; draw: TextFrames.DisplayMsg; exec: ExecMsg;
  411. BEGIN
  412.     draw.prepare := FALSE; draw.fnt := fnt; draw.col := col; draw.frame := F;
  413.     draw.X0 := X; draw.Y0 := Y;
  414.     W := SHORT(E.W DIV DUnit); H := SHORT(E.H DIV DUnit);
  415.     menuW := E.wid + 2*mhm; menuH := E.n*E.lsp + 2*mvm;
  416.     IF Y - menuH >= 0 THEN menuY := Y - menuH
  417.     ELSIF Y + H + menuH <= Display.Height THEN menuY := Y + H
  418.     ELSE menuY := 0
  419.     END;
  420.     IF X + menuW <= Display.Width THEN menuX := X
  421.     ELSE menuX := Max(X + W - menuW, 0)
  422.     END;
  423.     i := Display.Height - 2*mvm;
  424.     IF menuH > i THEN menuH := i DIV E.lsp * E.lsp + 2*mvm END;
  425.     cmd := Max(E.def, 0);
  426.     fullPlot := ~oldStyle;     (*<<RD*)
  427.     elemPressed := TRUE; E.handle(E, draw);
  428.     SelectMenu(E, F, menuX, menuY, menuW, menuH, X, Y, W, H, cmd, keys);
  429.     elemPressed := FALSE; E.handle(E, draw);
  430.     fullPlot:=TRUE;     (*<<RD*)
  431.     IF keys = {MM, MR} THEN OpenEditor(E)
  432.     ELSIF (keys # cancel) & (cmd > -1) THEN
  433.         E.def := cmd;
  434.         Set(r, E.menu, E.beg, cmd);
  435.         exec.frame := F; exec.pos := Texts.Pos(r); exec.keys := keys; E.handle(E, exec)
  436. END Popup;
  437. (* element *)
  438. PROCEDURE Handle* (E: Texts.Elem; VAR msg: Texts.ElemMsg);    
  439.     VAR e: Elem;
  440. BEGIN
  441.     WITH E: Elem DO
  442.         WITH
  443.           msg: TextFrames.DisplayMsg DO
  444.             IF msg.prepare THEN MeasureElem(E, msg.fnt)
  445.             ELSE DrawElem(E, msg.col, msg.X0, msg.Y0, msg.fnt)
  446.             END
  447.         | msg:TextPrinter.PrintMsg DO
  448.             IF ~msg.prepare THEN PrintElem(E, msg.X0, msg.Y0, msg.fnt) END
  449.         | msg:Texts.CopyMsg DO
  450.             IF msg.e = NIL THEN NEW(e); msg.e := e ELSE e := msg.e(Elem) END;
  451.             Texts.CopyElem(E, e);
  452.             e.name:=E.name; e.n := E.n; e.wid:=E.wid; e.lsp:=E.lsp; e.dsc:=E.dsc;
  453.             e.small := E.small; e.def := E.def;
  454.             e.menu:=TextFrames.Text(""); Texts.Save(E.menu, 0, E.menu.len, buf);
  455.             Texts.Append(e.menu, buf)
  456.         | msg:Texts.IdentifyMsg DO
  457.             msg.mod:="PopupElems"; msg.proc:="Alloc"
  458.         | msg:Texts.FileMsg DO
  459.             IF msg.id=Texts.load THEN Load(msg.r, E); MeasureMenu(E)
  460.             ELSIF msg.id=Texts.store THEN Store(msg.r, E)
  461.             END
  462.         | msg:TextFrames.TrackMsg DO
  463.             IF msg.keys = {MM} THEN
  464.                 Popup(E, msg.col, msg.X0, msg.Y0, msg.fnt, msg.frame); msg.keys := {}
  465.             END
  466.         | msg: ExecMsg DO ExecCmd(E, msg.frame, msg.pos, msg.keys)
  467.         ELSE
  468.         END
  469. END Handle;
  470. PROCEDURE Alloc*;    
  471.     VAR E: Elem;
  472. BEGIN NEW(E); E.handle:=Handle; Texts.new:=E
  473. END Alloc;
  474. PROCEDURE Insert0 (small: BOOLEAN);    
  475.     VAR E: Elem; S: Texts.Scanner; insert: TextFrames.InsertElemMsg;
  476. BEGIN
  477.     NEW(E); Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  478.     IF ~(S.class IN {Texts.Name, Texts.String}) THEN S.s := "Popup" END;
  479.     COPY(S.s, E.name); E.small := small;
  480.     E.menu := TextFrames.Text(""); SetDefaultMenu(E);
  481.     MeasureMenu(E); E.handle := Handle;
  482.     insert.e := E; Viewers.Broadcast(insert)
  483. END Insert0;
  484. PROCEDURE Insert*;    
  485. BEGIN Insert0(FALSE)
  486. END Insert;
  487. PROCEDURE InsertMenu*;    
  488. BEGIN Insert0(TRUE)
  489. END InsertMenu;
  490. PROCEDURE Toggle*;    
  491.     VAR E: Elem;
  492. BEGIN
  493.     IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN
  494.         E := Oberon.Par.frame.next(EditFrame).elem; E.small := ~E.small;
  495.         Restore(E)
  496. END Toggle;
  497. PROCEDURE Update*;    
  498.     VAR F: EditFrame; S: Texts.Scanner; menuText: Texts.Text; E: Elem;
  499. BEGIN
  500.     IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN
  501.         F := Oberon.Par.frame.next(EditFrame); E := F.elem;
  502.         menuText := Oberon.Par.frame(TextFrames.Frame).text;
  503.         Texts.OpenScanner(S, menuText, 0); Texts.Scan(S);
  504.         IF ~(S.class IN {Texts.Name, Texts.String}) THEN S.s := "Popup" END;
  505.         COPY(S.s, E.name); E.menu := CopyText(F.text);
  506.         MeasureMenu(E); Restore(E);
  507.         Texts.OpenReader(S, menuText, menuText.len-1); Texts.Read(S, S.c);
  508.         IF S.c = "!" THEN Texts.Delete(menuText, menuText.len-1, menuText.len) END
  509. END Update;
  510. BEGIN
  511.     elemPressed := FALSE; fullPlot := TRUE;
  512.     NEW(buf); Texts.OpenBuf(buf); Texts.OpenWriter(Wr)
  513. END PopupElems.
  514.